home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
007
/
colors.arc
/
COLORS.INC
< prev
next >
Wrap
Text File
|
1985-12-19
|
2KB
|
72 lines
const
_6845_Index = $3D4 ;
_6845_Data = $3D5 ;
ModeControl = $3D8 ;
MaxC = 6 ;
var
c :char ;
screen : array[0..7999,0..1] of byte absolute $B000:$8000 ;
screeni : array[0..7999] of integer absolute $B000:$8000 ;
hue : array[0..MaxC,0..MaxC,0..MaxC] of byte ;
inten : array[0..MaxC,0..MaxC,0..MaxC] of byte ;
colorfile : file of byte ;
procedure SetColors ;
var
r,g,b : integer ;
begin
assign(colorfile,'COLOR.DAT');
reset(colorfile) ;
for r := 0 to MaxC do
begin
for g := 0 to MaxC do
begin
for b := 0 to MaxC do
begin
read(colorfile,hue[r,g,b] );
read(colorfile,inten[r,g,b]) ;
end ;
end ;
end ;
Close(ColorFile) ;
end ;
procedure VideoReg(reg,data:integer) ;
begin
Port[_6845_Index]:=reg ;
Port[_6845_Data] :=data;
end ;
procedure NoBlink ;
begin
Port[ModeControl] := 9 ;
end ;
procedure MultiColor ;
begin
SetColors ;
TextMode(C80) ; {put into 80 colomn color mode}
VideoReg(4,$7F); {increase total lines to 255}
VideoReg(6,$64); {increase displayed lines to 200}
VideoReg(7,$70); {change sync position}
VideoReg(9,$03); {change to 4 scan lines high}
NoBlink ;
end ;
procedure NormalColor ;
begin
TextMode(C40) ;
TextMode(C80) ;
end ;
function Shade(c:integer;n:real):integer ;
var
sh : integer ;
begin
Sh := c+round(abs((MaxC/2)-c)*n) ;
if (sh<0) then shade := 0 else
if (sh>MaxC) then shade:=MaxC else
shade := sh ;
end ;